﻿
Partial Class Commodities_List
    Inherits System.Web.UI.Page
    Dim CArray(40, 13)
    Dim c, connstr, conn, rs, rs1
    Public tkey
    Function gethtml(ByVal tmp, ByVal s, ByVal e, ByVal id)
        'On Error Resume Next
        Dim String1, String2, arrstr, j
        String1 = s
        String2 = e
        Dim fbegin
        Dim fend
        fbegin = 1
        fend = 1
        j = 0
        Do
            fbegin = InStr(fbegin, tmp, String1)
            If fbegin = 0 Then Exit Function
            fend = InStr(fbegin, tmp, String2)
            arrstr = Mid(tmp, fbegin + Len(String1), fend - (fbegin + Len(String1)))
            If id <> -1 Then
                CArray(j, id) = arrstr
                j = j + 1
            End If
            gethtml = arrstr
            If id = -1 Then Exit Function
            fbegin = fend + Len(String2)
        Loop While True
    End Function
    Function getText(ByVal tmp, ByVal s, ByVal e)
        'On Error Resume Next
        Dim String1, String2, arrstr, j
        String1 = s
        String2 = e
        Dim fbegin
        Dim fend
        fbegin = 1
        fend = 1
        Do
            fbegin = InStr(fbegin, tmp, String1)
            If fbegin = 0 Then Exit Function
            fend = InStr(fbegin, tmp, String2)
            arrstr = Mid(tmp, fbegin + Len(String1), fend - (fbegin + Len(String1)))
            getText = arrstr
            fbegin = fend + Len(String2)
        Loop While True
    End Function
    Function getstr(ByVal iRemote)
        On Error Resume Next
        Dim xPost, sGet
        iRemote = iRemote
        xPost = SERVER.CreateObject("msxml2.serverxmlhttp") 'msxml2.serverxmlhttp
        xPost.Open("GET", iRemote, False)
        xPost.setrequestheader("referer", "http://taoke.alimama.com/spreader/search_auction.htm")
        xPost.Send()
        sGet = CreateObject("ADODB.Stream")
        sGet.Mode = 3
        sGet.Type = 1
        sGet.Open()
        sGet.Write(xPost.responseBody)
        sGet.Position = 0
        sGet.Type = 2
        sGet.Charset = "gb2312" ' "gb2312"
        getstr = sGet.ReadText
    End Function
    Function GetPid()
        rs.open("select *  from Config", conn, 1, 3)
        GetPid = rs("Pid").value
        rs.close()
    End Function
    Function GetGoodsList(ByVal od, ByVal cid, ByVal page, ByVal crs, ByVal cre, ByVal cs, ByVal ce, ByVal hs, ByVal he)
        Dim url, tempcode, a, CC, pagescount, curpage, h, Count, taokeurl, GoodsClass, c, i
        Dim ItemDescIUrl, ReviewsUrl, ItemViewsUrl, attributeslist, TaoBaoSale, tkeyWord, keyword
        Randomize()

        If od = "8" Then od = "5"
        If od = "7" Then
            od = "6"
        Else
            If od = "6" Then od = "7"
        End If
        If tkey <> "" Then
            tkeyWord = ""
            keyword = tkey
            For i = 1 To Len(keyword)
                If Asc(Mid(keyword, i, 1)) < 58 And Asc(Mid(keyword, i, 1)) >= 47 Then
                    tkeyWord = tkeyWord & Mid(keyword, i, 1)
                Else
                    tkeyWord = tkeyWord & " " & Mid(keyword, i, 1) & " "
                End If
            Next

            url = "http://taoke.alimama.com/spreader/auction_list.htm?c=&advsort=&mid=0&isMallRedirect=&q=" & Server.UrlEncode(tkeyWord) & "&cat=0&od=" & od & "&conts=&conte=&hs=&he=&cs=&ce=&rs=&re=&loc=&toPage=" & page & "&rnd=" & Rnd()
        Else
            url = "http://taoke.alimama.com/spreader/auction_list.htm?c=&advsort=&mid=0&isMallRedirect=&q=&cat=" & cid & "&od=" & od & "&conts=" & crs & "&conte=" & cre & "&hs=" & hs & "&he=" & he & "&cs=" & cs & "&ce=" & ce & "&rs=&re=&loc=&toPage=" & page & "&rnd=" & Rnd()

        End If


        Dim regex1 As Regex = New Regex("<[^>]*>")
        tempcode = getstr(url)

       
            tempcode = Replace(tempcode, "100) page.max=", "")
            tempcode = Replace(tempcode, "if(page.max=", "")
            tempcode = Replace(tempcode, ") page.cur=", "")
            If InStr(tempcode, "page.max") = 0 Then
                pagescount = 1
                curpage = 1
            Else
                pagescount = gethtml(tempcode, "page.max=", ";", 10) '当前分类名字
                curpage = gethtml(tempcode, "page.cur=", ";", 10) '当前分类名字
            End If
            CC = getText(tempcode, "<span id=""totalnum"" >", "</span>")
       
            tempcode = Replace(tempcode, "<span class=""H"">", "")
            tempcode = Replace(tempcode, "</span>", "")
          
            tempcode = getText(tempcode, "<div id=""listview"">", "<!--列表 结束-->")

            a = gethtml(tempcode, "<a class=""blue_14""", "</li>", 0)  '商品名称
            a = gethtml(tempcode, "<div class=""preprice"">", "元", 1)  '商品价格
            'a = gethtml(tempcode, """commissionRateReal"":""", """,""", 6)  '佣金比例
            a = gethtml(tempcode, "target=""_blank""><img src=""", """ onerror=", 5)  '商品PIC
            a = gethtml(tempcode, "<input type=""checkbox"" value=""", """ ac_data=", 4)  '商品ID


            GetGoodsList = pagescount & "<-pagecount" & CC & "p._.p"
            For i = 0 To 39
                If CArray(i, 1) <> "" Then
                GoodsClass = 0
                CArray(i, 0) = getText(CArray(i, 0), """>", "</a>")
                CArray(i, 5) = Replace(CArray(i, 5), "_sum.jpg", "_160x160.jpg")
                GetGoodsList = GetGoodsList & CArray(i, 0) & "@.@?168861" & CArray(i, 4) & "@.@?" & CArray(i, 1) & "@.@?" & CArray(i, 5) & "-.-?" & vbNewLine
                c = c + 1
            End If

                h = h + 1

            Next

            If h <> 0 And c = 0 Then
                c = -999
            End If

    End Function

    Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

        connstr = ConfigurationSettings.AppSettings("SQLConnString") & """" & Server.MapPath(".") & "\" & ConfigurationSettings.AppSettings("dbPath") & """"
        conn = Server.CreateObject("ADODB.Connection")
        conn.open(connstr)
        rs = Server.CreateObject("adodb.recordset")
        tkey = Request.QueryString("tkey")


    End Sub
    Function WeiYuanChuang(ByVal word)
        WeiYuanChuang = word
        Exit Function
        Dim WeiCode, WeiCodeArr, i, arr, WordStr
        WeiCode = ""
        If Application("WeiYuanChuangFileTxt") <> "" Then
            If Application("WeiYuanChuangFileSize") = GetSize("tyc.ini") Then
                WeiCode = Application("WeiYuanChuangFileTxt")
            Else
                WeiCode = LoadFile("tyc.ini")
                Application("WeiYuanChuangFileTxt") = WeiCode
                Application("WeiYuanChuangFileSize") = GetSize("tyc.ini")
            End If
        Else
            WeiCode = LoadFile("tyc.ini")
            Application("WeiYuanChuangFileTxt") = WeiCode
            Application("WeiYuanChuangFileSize") = GetSize("tyc.ini")
        End If
        If WeiCode = "" Then
            WeiYuanChuang = word
            Exit Function
        End If
        WeiCodeArr = Split(WeiCode, vbNewLine)
        For i = 0 To UBound(WeiCodeArr)
            If InStr(WeiCodeArr(i), ",") Then
                arr = Split(WeiCodeArr(i), ",")
                WordStr = arr(1)
                WordStr = Left(WordStr, 1) & "{--}" & Right(WordStr, Len(WordStr) - 1)
                word = Replace(word, arr(0), WordStr)
                WordStr = Replace(word, "{--}", "")
                WeiYuanChuang = WordStr
            End If
        Next
    End Function
    Function GetSize(ByVal filename)
        Dim fso, filepath, file, b, f, fsize, f_size
        fso = server.createobject("scripting.filesystemobject")
        filepath = server.mappath(filename)
        f = fso.getfile(filepath)
        fsize = f.size
        GetSize = fsize
        Exit Function
        If fsize > 1048576 Then
            f_size = left((fsize / 1024) / 1024, 4) & "MB"
        ElseIf fsize > 1024 Then
            f_size = left(fsize / 1024, 4) & "KB"
        Else
            f_size = fsize
        End If
        GetSize = fsize
    End Function
    Function LoadFile(ByVal File)
        Dim objStream
        On Error Resume Next
        objStream = Server.CreateObject("ADODB.Stream")
        If Err.Number = -2147221005 Then
            LoadFile = ""
            Exit Function
        End If
        With objStream
            .Type = 2
            .Mode = 3
            .Open()
            .LoadFromFile(Server.MapPath(File))
            If Err.Number <> 0 Then
                LoadFile = ""
                Exit Function
            End If
            .Charset = "GB2312"
            .Position = 2
            LoadFile = .ReadText
            .Close()
        End With
        objStream = Nothing
    End Function
End Class
